home *** CD-ROM | disk | FTP | other *** search
/ LOGIC Apps / Logic-APPLE_II_APPS.iso / mac / LOGIC Apple II 5.25" Library - ProDOS / PRO004.dsk / SORT.bas < prev    next >
BASIC Source File  |  2012-02-16  |  4KB  |  96 lines
  1. 10  REM  <<   FILE CABINET   >>
  2. 20  REM  <<      PRODOS      >>
  3. 30  REM  <<   SORT MODULE    >>
  4. 40  REM  <<   CONVERTED BY   >>
  5. 50  REM  <<   MICHAEL MOORE  >>
  6. 60  REM  <<     MAY 1984     >>
  7. 70 :
  8. 100  GOTO 5400: REM      << SORT ROUTINE >>
  9. 2400  REM  << GENERAL PURPOSE ROUTINE >>>
  10. 2410  PRINT L$"->":V =  PEEK(37)::H =  LEN(L$) +3
  11. 2420  VTAB V: HTAB H: CALL  -868: INPUT "";R$:R =  VAL(R$): CALL  -958
  12. 2430  IF R <1  OR R >CHOICE  THEN 2450
  13. 2440  PRINT : RETURN 
  14. 2450  IF V = 23  THEN V = 22
  15. 2460  CALL  -868: PRINT " ENTER NUMBER 1 THRU ";CHOICE: GOTO 2420
  16. 2469 :
  17. 2500  REM  <<<< GET ANSWER ROUTINE >>>
  18. 2510 V =  PEEK(37) +1
  19. 2515  PRINT L$" (Y/N)"
  20. 2520  IF V >23  THEN V = 23
  21. 2530  VTAB V: HTAB ( LEN(L$) +8): CALL  -868: INPUT A$: IF A$ = "Y"  THEN YES = 1: RETURN 
  22. 2540  IF A$ = "N"  THEN YES = 0: RETURN 
  23. 2550  INVERSE : PRINT " PRESS 'Y' OR 'N'...": NORMAL : IF V =  >23  THEN V = 22
  24. 2560  GOTO 2530
  25. 5000  REM      <<< SORT ROUTINE  >>>>
  26. 5010 N = NR:M = N:FF = 0: ONERR  GOTO 5080
  27. 5020 M =  INT(M/2):K = N -M:J = 1: PRINT "SORTING ";: IF M = 0  THEN  PRINT  CHR$(13): GOTO 5100
  28. 5030 I = J
  29. 5040 LL = I +M:I2 = R(I):L2 = R(LL): ON L GOTO 5050,5060: ON ( VAL(N$(I2,S)) =  > VAL(N$(L2,S))) GOTO 5080: GOTO 5070
  30. 5050  ON (N$(I2,S) < = N$(L2,S)) GOTO 5080: GOTO 5070
  31. 5060  ON ( VAL(N$(I2,S)) < =  VAL(N$(L2,S))) GOTO 5080
  32. 5070 Y = R(I):R(I) = R(LL):R(LL) = Y:I = I -M: IF I > = 1  THEN 5040
  33. 5080 J = J +1: IF J >K  THEN 5020
  34. 5090  GOTO 5030
  35. 5100  POKE 216,0: HTAB 10: INVERSE : FLASH : PRINT " <SORTING COMPLETE> ": NORMAL 
  36. 5200  PRINT : PRINT "WANT TO SAVE >"FD$"< FILE":L$ = "SORTED BY >" +H$(S) +"< TO DISK ": GOSUB 2510: IF YES  THEN F$ = "INDEX": GOSUB 24010
  37. 5210  GOTO 28010
  38. 5400 MF = 1: GOSUB 21010
  39. 5410 L$ = "ENTER # OF FIELD FOR SORT ":CHOICE = NH: GOSUB 2410:S = R
  40. 5411 ST = 0
  41. 5412  IF NR =  <40  THEN ST = 2
  42. 5413  IF NR >40  THEN ST = 6
  43. 5414  IF NR >90  THEN ST = 15
  44. 5415  IF NR >140  THEN ST = 70
  45. 5416  IF NR >200  THEN ST = 150
  46. 5417  IF NR >250  THEN ST = 250
  47. 5418  IF NR >300  THEN ST = 370
  48. 5419  PRINT : PRINT "SORT WILL TAKE APPROX. ";: FLASH : PRINT (ST + INT(.06 *NR * LOG(NR)));: NORMAL : PRINT " SECONDS": PRINT 
  49. 5420  PRINT : PRINT "DO YOU WANT TO SORT:": PRINT 
  50. 5430  PRINT "1 ALPHABETICALLY"
  51. 5440  PRINT "2 NUMERICALLY (LOW TO HIGH)"
  52. 5450  PRINT "3 NUMERICALLY (HIGH TO LOW)": PRINT 
  53. 5460 L$ = "WHICH ":CHOICE = 3: GOSUB 2410:L = R
  54. 5470  PRINT : PRINT : GOTO 5010
  55. 21000  REM  <<< SELECT SUB ROUTINE >>
  56. 21010  HOME : PRINT "SELECT FROM:": PRINT 
  57. 21020  IF MF = 0  THEN  PRINT "O "H$(0)
  58. 21030  FOR I = 1 TO NH: PRINT I"  ";H$(I): NEXT I:NS = NR
  59. 21040 MF = 0
  60. 21050  RETURN 
  61. 24000  REM  << WRITE INDEXFILE >>>>
  62. 24010 NR$ =  RIGHT$("00000" + STR$(NR),5)
  63. 24020 FF = 0: IF F$ < >"INDEX"  THEN FF = 1
  64. 24030 Q$ = PB$ +FD$ +"/" +F$
  65. 24040  PRINT D$"OPEN"Q$: PRINT D$"WRITE"Q$
  66. 24050  PRINT NR$
  67. 24060  FOR J = 1 TO NR
  68. 24070  ON FF GOTO 24130
  69. 24080 Y = R(J)
  70. 24090  FOR I = 1 TO NH
  71. 24100  PRINT N$(Y,I)
  72. 24110  NEXT I
  73. 24120  GOTO 24140
  74. 24130  PRINT R$(J)
  75. 24140  NEXT J
  76. 24150  PRINT D$"CLOSE"
  77. 24160 FF = 0
  78. 24170  RETURN 
  79. 28010  PRINT D$"CHAIN";PX$ +"MAIN"
  80. 30000  REM   <<< SORT MODULE FOR FILE CABINET - USING PRODOS >>>>
  81. 61000  REM  ********************* 
  82. 61010  REM       FILE CABINET
  83. 61020  REM         PRODOS
  84. 61030  REM  --------------------- 
  85. 61040  REM      CONVERTED BY
  86. 61050  REM      MICHAEL MOORE
  87. 61060  REM         MAY 1984
  88. 61070  REM  =====================
  89. 61080  REM       BASED ON
  90. 61090  REM   FILE CABINET-MACH 5
  91. 61100  REM      BY ED AYMOND
  92. 61110  REM    AND BOB MATZINGER
  93. 61120  REM   AS A MODIFICATION
  94. 61130  REM   OF EARLIER VERSIONS
  95. 61140  REM  *********************
  96. 61150  REM  APPLE CORPS OF DALLAS